VBA to open Stationary

HCL Notes/Domino 8.5 Forum (includes Notes Traveler)

Subject: VBA to open Stationary

Feedback Type: Problem

Product Area: Notes Client

Technical Area: Application Development

Platform: Windows

Release: 8.5.1

Reproducible: -Reproducibility-

Good morning all!

I am trying to develope some VBA code. I basically want the code to stored on a Excel spreadsheet. I want the code to basically open a shared mailbox and then access a specific stationary. Now, I have the code to open Notes, compose an email, fill in the subject, body, etc fields, and attach a file. I also have code retrieve the stationary details (body, subject, stationaryname, and etc). So how can I get my code to open a specific stationary (by name or ID) and then attach one or multiple files. I dont want the Memo to be sent. I want the user to review the email before sent.

Here is what I have to access either all stationary content or first entry.

Sub get_stationary()
Dim Maildb As Object, view As Object, Session As Object, entry As Object, entries As Object

Sheets("Sheet2").Select
counter = 2

Set Session = CreateObject("Notes.NotesSession")

Set Maildb = Session.GETDATABASE("", "")
If Maildb.IsOpen = False Then
Maildb.OPENMAIL
End If

Set view = Maildb.GetView("Stationery")
Set entries = view.AllEntries

If entries.Count = 0 Then
Exit Sub
End If

Set entry = entries.GetFirstEntry

Do Until entry Is Nothing
With entry.Document
Range("A" & counter) = Join(.GetItemValue("entersendto"), ", ")
Range("B" & counter) = Join(.GetItemValue("entercopyto"), ", ")
Range("C" & counter) = Join(.GetItemValue("enterblindcopyto"), ", ")
Range("D" & counter) = .GetItemValue("subject")
Range("E" & counter) = .GetItemValue("body")
Range("F" & counter) = .GetItemValue("MailStationeryName")
End With
counter = counter + 1
Set entry = entries.GetNextEntry(entry)
Loop

Set Maildb = Nothing
Set Session = Nothing
End Sub

What I basically want is code to open a stationary by ID or Name. Then attach the current file (and maybe more files that are stored in same or different location). Any ideas?

Here is my code (orginally developed by Nate Oliver) to open a memo and attach the current file (cannot find out how to attach multiple).

Sub LotusNotsSendActiveWorkbook()
'Send an e-mail & attachment using Lotus Not(s)
'Original Code by Nate Oliver (NateO)
'Declare Variables for file and macro setup
Dim UserName As String, MailDbName As String, ccRecipient As String, attachment1 As String
Dim Maildb As Object, MailDoc As Object, AttachME As Object, Session As Object
Dim EmbedObj1 As Object
With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = _
Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", "")
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
' Select range of e-mail addresses
'ccRecipient = Sheets("EmailSheet").Range("B2").Value
' Or send to a signle address
MailDoc.Sendto = "bob@ibm.com"
MailDoc.CopyTo = ccRecipient
' Subject & Body stored in a**worksheet
'MailDoc.Subject = Sheets("EmailSheet").Range("C2").Value
' MailDoc.Body = Sheets("EmailSheet").Range("ENTER CELL OF BODY").Value
' These can be entered here manually instead
MailDoc.Subject = "Check this out!"
MailDoc.Body = "Made you look!"

' Select Workbook to Attach to E-Mail
MailDoc.SaveMessageOnSend = True
MsgBox ActiveWorkbook.FullName
attachment1 = ActiveWorkbook.FullName
If attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", ActiveWorkbook.FullName, "")
On Error Resume Next
End If

'Displays email message without sending; user needs to click Send
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

End Sub

Feedback number WEBB8A2K5Q created by ~Dan Desjipyobu on 10/08/2010

Status: Open
Comments: